#!/usr/bin/perl
# by jzhang @ 13:37 2006-08-02  mailto:jzhang533@gmail.com
#
package jzhang::Util;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(today strip_html decode_res_content decode_content extract_title read_config_mem read_config read_config_from_env get_std_cur_time get_last_path);
our @EXPORT = qw();
our %EXPORT_TAGS = (
    'all' => [ @EXPORT_OK,@EXPORT ]
    );

use warnings;
use strict;

our $Detector;

BEGIN {
    if ( eval { require Encode::Detect::Detector; 1 } ) {
        $Detector = sub { Encode::Detect::Detector::detect($_[0]) };
    } else {
        require Encode::Guess;
        $Detector = sub {
            my @guess = qw(utf-8 gbk gb2312 gb18030); # xxx Chinese only?
            eval { Encode::Guess::guess_encoding($_[0], @guess)->name };
        };
    }
}

sub strip_html {
    my $html = shift;
    return if not defined $html;
    $html =~ s/<[^>]*>//g;
    HTML::Entities::decode($html);
}

#
# the input is a HTTP::Response object
# in order to save bandwidth, some servers compress the content
# (mod_gzip), the client has to decompress the content
# 
sub decode_res_content {
    my $res = shift;

    return undef if !ref($res);
    return undef if ref($res) ne 'HTTP::Response';

    my $content_ref;
    my $content_ref_iscopy;

eval {
    require HTTP::Headers::Util;
    my($ct, %ct_param);
    if (my @ct = HTTP::Headers::Util::split_header_words($res->header("Content-Type"))) {
        ($ct, undef, %ct_param) = @{$ct[-1]};
        $ct = lc($ct);
        die "Can't decode multipart content" if $ct =~ m,^multipart/,;
    }

    $content_ref = $res->content_ref;
    die "Can't decode ref content" if ref($content_ref) ne "SCALAR";

    if (my $h = $res->header("Content-Encoding")) {
        $h =~ s/^\s+//;
        $h =~ s/\s+$//;

        # the content may been compressed by a series of methods:
        # applying the decompressing methods in the reverse order
        for my $ce (reverse split(/\s*,\s*/, lc($h))) {
            next unless $ce || $ce eq "identity";
            if ($ce eq "gzip" || $ce eq "x-gzip") {
                require Compress::Zlib;
                unless ($content_ref_iscopy) {
                    # memGunzip is documented to destroy its buffer argument
                    my $copy = $$content_ref;
                    $content_ref = \$copy;
                    $content_ref_iscopy++;
                }
                $content_ref = \Compress::Zlib::memGunzip($$content_ref);
                die "Can't gunzip content" unless defined $$content_ref;
            }
            elsif ($ce eq "x-bzip2") {
                require Compress::Bzip2;
                $content_ref = Compress::Bzip2::decompress($$content_ref);
                die "Can't bunzip content" unless defined $$content_ref;
                $content_ref_iscopy++;
            }
            elsif ($ce eq "deflate") {
                require Compress::Zlib;
                my $out = Compress::Zlib::uncompress($$content_ref);
                unless (defined $out) {
                    # "Content-Encoding: deflate" is supposed to mean the "zlib"
                    # format of RFC 1950, but Microsoft got that wrong, so some
                    # servers sends the raw compressed "deflate" data.  This
                    # tries to inflate this format.
                    unless ($content_ref_iscopy) {
                        # the $i->inflate method is documented to destroy its
                        # buffer argument
                        my $copy = $$content_ref;
                        $content_ref = \$copy;
                        $content_ref_iscopy++;
                    }

                    my($i, $status) = Compress::Zlib::inflateInit(
                        WindowBits => -Compress::Zlib::MAX_WBITS(),
                        );
                    my $OK = Compress::Zlib::Z_OK();
                    die "Can't init inflate object" unless $i && $status == $OK;
                    ($out, $status) = $i->inflate($content_ref);
                    if ($status != Compress::Zlib::Z_STREAM_END()) {
                        if ($status == $OK) {
                            #  Content might be truncated; incomplete deflate stream;
                        }
                        else {
                            # something went bad, can't trust $out any more
                            $out = undef;
                        }
                    }
                }
                die "Can't inflate content" unless defined $out;
                $content_ref = \$out;
                $content_ref_iscopy++;
            }
            elsif ($ce eq "compress" || $ce eq "x-compress") {
                die "Can't uncompress content";
            }
            elsif ($ce eq "base64") {  # not really C-T-E, but should be harmless
                require MIME::Base64;
                $content_ref = \MIME::Base64::decode($$content_ref);
                $content_ref_iscopy++;
            }
            elsif ($ce eq "quoted-printable") { # not really C-T-E, but should be harmless
                require MIME::QuotedPrint;
                $content_ref = \MIME::QuotedPrint::decode($$content_ref);
                $content_ref_iscopy++;
            }
            else {
                die "Don't know how to decode Content-Encoding '$ce'";
            }
        }
    }
};
    if ($@) {
        return undef;
    }

    $$content_ref;
}

# 
# the input can be a HTTP::Response object or XML, HTML, raw text
# this is modified from plagger, but the RE here is more aggressive
# and the claim header of XML/HTML is modified to utf-8 for consistence
#
sub decode_content {
    my $stuff = shift;

    my $content;
    my $res;
    if (ref($stuff) && ref($stuff) eq 'HTTP::Response') { # http response
        $res     = $stuff;
        $content = decode_res_content($res);
    } elsif (ref($stuff)) { # dont know how to decode
        return undef;
    } else { 
        $content = $stuff;
    }
    # if there is a charset made by caller
    my $charset = shift;

    # 1) if it is HTTP response, get charset from HTTP Content-Type header
    if ($res) {
        $charset ||= ($res->content_type =~ /charset=([\w\-]+)/i)[0];
    }
    
    # 2) if there's not, try XML encoding

    $charset ||= ( $content =~ /<\?xml[^>]+encoding="([^"]+)"/i )[0];
    # replace the claim header
    $content =~ s/<\?xml([^>]+)encoding="[^"]+"/<\?xml$1encoding="utf-8"/i if $charset;

    # 3) if there's not, try META tag
    $charset ||= ( $content =~ m!<meta[^<>]+charset=([^"]+)"!i )[0];
    # replace the claim header						      
    $content =~ s!<meta([^<>]+)charset=[^"]+"!<meta$1charset=utf-8"!i if $charset; 

    # 4) if there's not still, try Detector/Guess
    $charset ||= $Detector->($content);

    # 5) falls back to UTF-8
    $charset ||= 'utf-8';
	$charset = 'gbk' if ($charset =~ m!gb2312!i);
    
    my $decoded = eval { Encode::decode($charset, $content) };

    if ($@ && $@ =~ /Unknown encoding/) {
        $charset = $Detector->($content) || 'utf-8';
        $decoded = Encode::decode($charset, $content);
    }

    $decoded;
}

sub extract_title {
    my $content = shift;
    my $title = ($content =~ m!<title>\s*(.*?)\s*</title>!is)[0] or return;
    HTML::Entities::decode($1);
}

#
# read config from a file
# return a refernce of a hash table which contains the configuration info
#
sub read_config{
    open CONFIG, "$_[0]" or die "can not open $_[0],$!\n";
    local $/=undef;
    my $str=<CONFIG>;
    close CONFIG;
    return read_config_mem($str);
}

sub read_config_mem{
    my $ref_content;
    if(not ref($_[0])){
        $ref_content = \$_[0];
    }else{
        $ref_content = shift;
    }

    my %configs=();

    foreach(split(/[\r\n]+/,$$ref_content)){
        if(/^\s*\#/){ # a line starts with a # is an comments      
        }
        elsif(/^\s*$/){ # a blank line
        }
        elsif(/([^=\s]+)\s*=\s*(.*)$/){
            $configs{$1} = $2;
        }
    }

    return \%configs;
}


sub read_config_from_env{
    return read_config($ENV{$_[0]});
}


sub get_std_time {
    my ($input_time) = @_ ;
    my ($cur_year,$cur_mon,$cur_day,$cur_hour,$cur_min,$cur_sec) = (localtime($input_time))[5,4,3,2,1,0];
    $cur_year += 1900;
    $cur_mon++;
    return $cur_year.'-'.$cur_mon.'-'.$cur_day.' '.$cur_hour.':'.$cur_min.':'.$cur_sec;
}    

sub get_std_cur_time {
    my ($cur_year,$cur_mon,$cur_day,$cur_hour,$cur_min,$cur_sec) = (localtime(time))[5,4,3,2,1,0];
    $cur_year += 1900;
    $cur_mon++;
    return $cur_year.'-'.$cur_mon.'-'.$cur_day.' '.$cur_hour.':'.$cur_min.':'.$cur_sec;
}    


sub today{
    my ($cur_year,$cur_mon,$cur_day) = (localtime(time))[5,4,3];
    $cur_year += 1900;
    $cur_mon++;
    $cur_mon="0$cur_mon" if length($cur_mon)<2;
    $cur_day="0$cur_day" if length($cur_day)<2;
    return "$cur_year$cur_mon$cur_day";
}

#
# IN: path
#   : SUFFIX => suffix (opt)
#   : DATE_DIR => date_dir (opt)
# NOTICE: only relative path(without suffix) is returned
#       : *nix system only, because of `date +%Y%m%d`  
#
sub get_last_path{
    use Cwd;
    use File::Basename;
    
    my $news_data_dir = shift;
    my %p = @_;
    
    my $date_dir;
    if( exists $p{DATE_DIR} ){
        $date_dir = $p{DATE_DIR};
    }else{
        $date_dir = today();
    }
    my $suffix;
    if( exists $p{SUFFIX} ){
        $suffix = $p{SUFFIX};
        $suffix='.'.$suffix;
    }    
    
    #change current work directory to news_data_dir
    my $work_dir = getcwd();
    chdir($news_data_dir);
    
    #if that date dir is not existing then create it
    if (! (-e $date_dir && -d $date_dir)) {
        mkdir("$date_dir",0777);
    }
    
    #search the last number dir in this date dir

    my $last_dir_no = 0 ;
    while(-e "$date_dir/$last_dir_no" and -d "$date_dir/$last_dir_no"){
        $last_dir_no ++;
    }

    mkdir("$date_dir/$last_dir_no",0777) if $last_dir_no == 0;
    $last_dir_no -- if $last_dir_no > 0;
    #search the last file number in this date dir
    my $last_file_no = 0;
    while(-e "$date_dir/$last_dir_no/$last_file_no$suffix"){
        $last_file_no ++;
    }

    if ($last_file_no > 1023) {
        $last_file_no = '0';      
        $last_dir_no++;
        mkdir("$date_dir/$last_dir_no",0777);
    }
    
    #recover the current work directory
    chdir($work_dir);
    
    return "$date_dir/$last_dir_no/$last_file_no";
}

1;

